home *** CD-ROM | disk | FTP | other *** search
/ United Public Domain Gold 2 / United Public Domain Gold 2.iso / utilities / pu358.dms / pu358.adf / DonsGenies / Don'sGenies / StyleTagsAutoCreate.pprx < prev    next >
Text File  |  1992-08-04  |  20KB  |  494 lines
  1. /* This genie creates new style tags automatically by examining all the text in a document. If any text is in a style which does not match an existing tag, a new tag is created and the text is set to that tag. Tags are named with a simplified description of the typeface; you can alter any of these names to anything you wish (using the "Style Tags Modify" menu item). If you modify the tag, its typeface name might no longer suit it.
  2. Written and © Don Cox  July 1992.  Freely usable for non-commercial purposes. */
  3.  
  4. /* Method: load in typographic data from article texts. If an existing style is used, see if it is modified (further data after the style name). Ignore any data for text after the first letter. If no existing style is used, assemble the data and compare with all existing styles to see if there is a match. If not, suggest a name for a new style, create it and apply it to the block. */
  5.  
  6.  
  7. trace n
  8. if ~show(l, "gdarexxsupport.library") then
  9.     if ~(exists("libs:gdarexxsupport.library") & addlib("gdarexxsupport.library", 0, -30)) then
  10.         exit_msg("Please install the gdarexxsupport.library in your libs: directory before running this Genie")
  11.     
  12.  
  13. address command
  14. call SafeEndEdit.rexx()
  15. call ppm_AutoUpdate(0)
  16. colormode = ppm_GetColorMode()
  17. call ppm_SetColorMode(0)
  18. cpage   = ppm_CurrentPage()
  19.  
  20.  
  21. tolerant = ppm_Inform(2,"Ignore bold, italic and underline?","No","Yes")
  22. call ppm_ShowStatus("Working..")
  23.  
  24. existing = 0   /* flag for style matching existing style  */
  25. randval = (randu() * time(s)) % 1 /* mark boxes with random number to avoid doing them twice */
  26. box = ppm_DocFirstBox()
  27.  
  28. do while box ~= 0
  29.  
  30.     info    = upper(word(ppm_GetBoxInfo(box), 1))
  31.  
  32.     if (info = "TEXT") & (ppm_GetBoxUserData(box) ~= randval) then do
  33.         oldbox = box
  34.         box = ppm_ArtFirstBox(box)
  35.         text = ppm_GetArticleText(box, 1)
  36.         call ppm_ShowStatus("  Analysing article that begins in box "box)
  37.         if text  = '' then iterate
  38.  
  39.         paraname = ""
  40.         paracode = ""
  41.         stylename = ""
  42.         stylecode = ""
  43.         fontname = ""
  44.         typestyle = ""
  45.         fontsize = ""
  46.         bold = ""
  47.         italic = ""
  48.         underline = ""
  49.         outline = ""
  50.         kerning = ""
  51.         hyphenation = ""
  52.         linespace = ""
  53.         linespacecode = ""
  54.         lineshift = ""
  55.         tracking = ""
  56.         colour = ""
  57.         justification = ""
  58.  
  59. position = 1
  60. trace n
  61.         do x = 1 to 10000  /* big number - go right through article  */
  62.             change = 0
  63.             notcode = 0
  64.             position = parsecodes(position) /* parse a block of codes in text */
  65.             if position = 0 then break
  66.             if stylecode = "dS" then iterate
  67.             if notcode = 1 then iterate   /* non-style codes  */
  68.  
  69. /* put together style definition from text */
  70.             trackstring = "\t<"tracking">"
  71.             if tracking = "" then trackstring = ""
  72.             linespacestring = "\"linespacecode"<"||linespace||">"
  73.             if linespacecode = "" | linespacecode = "" then linespacestring = ""
  74.             fontnamestring = "\ff<"fontname">"
  75.             if fontname = "" then fontnamestring = ""
  76.             fontsizestring = "\fs<"fontsize">"
  77.             if fontsize = "" then fontsizestring = ""
  78.             colourstring = "\c<"colour">"
  79.             if colour = "" then colourstring = ""
  80.             styledefinition = "\"paracode||paraname ||typestyle ||bold ||italic ||outline ||underline || fontnamestring|| fontsizestring|| justification|| kerning|| hyphenation|| linespacestring|| trackstring||colourstring
  81.             
  82.             if tolerant = 1 then styledefinition = "\"paracode||paraname || fontnamestring|| fontsizestring|| justification|| kerning|| hyphenation|| linespacestring|| trackstring||colourstring
  83.             
  84. /* see if new definition matches any of the old ones */
  85.             stylelist = ppm_GetStyleTagList()
  86.             stylelistTest = stylelist||"0a"x
  87.             parse var stylelist NumberOfTags "0a"x stylelist
  88.  
  89.             if NumberOfTags~=0 then do
  90.                 do t=1 to NumberOfTags
  91.                     parse var stylelist thisname "0a"x stylelist
  92.                     thisdata = ppm_GetStyleTagData(thisname)
  93.                     thisdata = substr(thisdata, pos("{",thisdata)+1)
  94.                     thisdata = left(thisdata, lastpos("}",thisdata)-1)
  95.                     if tolerant = 1 then do  /* take out unwanted codes */
  96.                         p=pos(thisdata,"\B")
  97.                         if p~=0 then thisdata = delstr(thisdata,p,2)
  98.                         p=pos(thisdata,"\b")
  99.                         if p~=0 then thisdata = delstr(thisdata,p,2)
  100.                         p=pos(thisdata,"\U")
  101.                         if p~=0 then thisdata = delstr(thisdata,p,2)
  102.                         p=pos(thisdata,"\u")
  103.                         if p~=0 then thisdata = delstr(thisdata,p,2)
  104.                         p=pos(thisdata,"\I")
  105.                         if p~=0 then thisdata = delstr(thisdata,p,2)
  106.                         p=pos(thisdata,"\i")
  107.                         if p~=0 then thisdata = delstr(thisdata,p,2)
  108.                         end
  109.                     if thisdata = styledefinition then do
  110.                         ThisTagName = "\dS<"||thisname||">"
  111.                         if stylecode~= "dS" then text = insert(ThisTagName,text, position-2)
  112.                         change = 0 
  113.                         leave t
  114.                         end
  115.                     end   /* t=1 to NumberOfTags  */
  116.             end
  117.      
  118.             if change = 0 then iterate x   /* No need to make a new tag */
  119.  
  120.             
  121.             numbering = 1
  122.             newbold = ""
  123.             if right(bold,1) = "B" then newbold = "B"
  124.             newitalic = ""
  125.             if right(italic,1) = "I" then newitalic = "I"
  126.             suggestname = left(fontname, 9)||newbold||newitalic||"."||(fontsize%1)||"pt."||colour
  127.             testsuggest = "0a"x||suggestname||"0a"x
  128.     
  129.             do i = 1 to 999  /* if name already used, give it a new number */
  130.                 if pos(testsuggest,stylelistTest)=0 then break
  131.                 numbering = numbering+1
  132.                 suggestname = left(fontname, 9)||newbold||newitalic||"."||(fontsize%1)||"pt."||colour"."||right(numbering, 3,"0")
  133.                 testsuggest = "0a"x||suggestname||"0a"x
  134.                 end
  135.        
  136.             ThisTagName = "\dS<"||suggestname||">"
  137.             text = insert(ThisTagName,text, position-2)
  138.             position = position+3
  139.             styledefinition = "<"suggestname"{"styledefinition"}>"
  140.             call ppm_DefineStyleTag(styledefinition)      
  141.             end   /* of article text - position = 0  */
  142.       
  143. /* replace text with new version containing new style codes */
  144.         gone = ppm_DeleteContents(box)
  145.         overflow = ppm_TextIntoBox(box, text)
  146.         do while box ~= 0  /* mark all the other boxes in this chain  */
  147.             call ppm_SetBoxUserData(box, randval)
  148.             box = ppm_ArtNextBox(box)
  149.             end
  150.         box = oldbox  /* back to the box we are working on */
  151.         end
  152.  
  153.     box = ppm_DocNextBox(box)
  154.  
  155. end
  156.  
  157.  
  158. title = ppm_GetDocName()
  159. colon = lastpos('/', title)
  160. if colon = 0 then colon = pos(':', title)
  161. title = substr(title,colon+1)
  162.  
  163. datafile = "ram:"||title||".tags"
  164. stylelist = ppm_GetStyleTagList()
  165. parse var stylelist NumberOfTags "0a"x stylelist
  166. text ="List of style tags"||"0a0a"x
  167.  
  168. if NumberOfTags~=0 then do
  169.     do t=1 to NumberOfTags
  170.         parse var stylelist thisname "0a"x stylelist
  171.         thisdata = ppm_GetStyleTagData(thisname)
  172.         text = text||thisdata"0a"x
  173.         end   /* t=1 to NumberOfTags  */
  174.     end
  175.  
  176. paralist = ppm_GetParaTagList()
  177. parse var paralist NumberOfTags "0a"x paralist
  178. text =text||"0a"x||"List of paragraph tags"||"0a0a"x
  179.  
  180. if NumberOfTags~=0 then do
  181.     do t=1 to NumberOfTags
  182.         parse var paralist thisname "0a"x paralist
  183.         thisdata = ppm_GetParaTagData(thisname)
  184.         text = text||thisdata"0a"x
  185.         end   /* t=1 to NumberOfTags  */
  186.     end
  187.  
  188. call ppm_SaveText(datafile,text)
  189. call exit_msg()
  190. end
  191.  
  192. /*  ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++  */
  193.  
  194. /* Parse a block of style codes in text; stop at first text character  */
  195.  
  196. parsecodes:
  197. parse arg position
  198. position = pos("\",text,position)
  199. if position = 0 then return position
  200. if substr(text,position+1,1) = "." then position = 0 /* end of text */
  201. if position = 0 then return position
  202. stylecode = "ds"  /* assume new block of codes means new style */
  203.  
  204.         do forever
  205.             if substr(text,position,1)~="\" then break
  206.             if substr(text,position+1,1) = "." then position = 0
  207.             if position = 0 then break
  208.             code = substr(text,position+1,2)
  209. trace n
  210.             select
  211.                 when verify(left(code,1),"NMPTs-!?#","m")~=0 then do
  212.                     position = position+2 /* non-style codes */
  213.                     change = 0
  214.                     notcode = 1
  215.                     end
  216.                 when code = "dp" then do
  217.                     paraname = ""
  218.                     paracode = code
  219.                     position = position+3
  220.                     end
  221.                 when code = "dP" then do
  222.                     position1 = pos(">",text,position)
  223.                     position = position+4
  224.                     oldname = paraname
  225.                     paraname = "<"||substr(text, position, position1-position)||">"
  226.                     if paraname~=oldname  then change = 1
  227.                     oldname = paracode
  228.                     paracode = "dP"
  229.                     if paracode~=oldname  then change = 1
  230.                     position = position1+1
  231.                     end
  232.                 when code = "ds" then do
  233.                     stylename = ""
  234.                     stylecode = code
  235.                     position = position+3
  236.                     end
  237.                 when code = "dS" then do
  238.                     position1 = pos(">",text,position)
  239.                     position = position+4
  240.                     stylename = substr(text,position,position1-position)
  241.                     tagdata = ppm_GetStyleTagData(stylename)
  242.                     call parsetag(tagdata) /* new style so reset all variables  */
  243.                     change = 0
  244.                     stylecode = "dS"
  245.                     position = position1+1
  246.                     end
  247.                 when verify(left(code,1),"bB","m")~=0 then do
  248.                     oldname = bold
  249.                     bold = "\"||left(code,1)
  250.                     position = position+2
  251.                     if bold~=oldname  then change = 1
  252.                     end
  253.                 when verify(left(code,1),"iI","m")~=0 then do
  254.                     oldname = italic
  255.                     italic = "\"||left(code,1)
  256.                     position = position+2
  257.                     if italic~=oldname  then change = 1
  258.                     end
  259.                 when verify(left(code,1),"uU","m")~=0 then do
  260.                     oldname = underline
  261.                     underline = "\"||left(code,1)
  262.                     position = position+2
  263.                     if underline~=oldname  then change = 1
  264.                     end
  265.                 when verify(left(code,1),"oO","m")~=0 then do
  266.                     oldname = outline
  267.                     outline = "\"||left(code,1)
  268.                     position = position+2
  269.                     if outline~=oldname  then change = 1
  270.                     end
  271.                 when left(code,1) = "n" then do
  272.                     typestyle = ""
  273.                     if bold~="" then change = 1
  274.                     bold = "\b"
  275.                     if italic~="" then change = 1
  276.                     italic = "\i"
  277.                     if underline~="" then change = 1
  278.                     underline = "\u"
  279.                     if outline~="" then change = 1
  280.                     outline = "\o"
  281.                     position = position+2
  282.                     end
  283.                 when code = "ff" then do
  284.                     position1 = pos(">",text,position)
  285.                     position = position+4
  286.                     oldname = fontname
  287.                     fontname = substr(text,position,position1-position)
  288.                     if fontname~=oldname  then change = 1
  289.                     position = position1+1
  290.                     end
  291.                 when code = "fs" then do
  292.                     position1 = pos(">",text,position)
  293.                     position = position+4
  294.                     oldname = fontsize
  295.                     fontsize = substr(text,position,position1-position)
  296.                     if fontsize~=oldname  then change = 1
  297.                     position = position1+1
  298.                     end
  299.                 when verify(left(code,1),"kK","m")~=0 then do
  300.                     oldname = kerning
  301.                     kerning = "\"||left(code,1)
  302.                     position = position+2
  303.                     if kerning~=oldname  then change = 1
  304.                     end
  305.                 when verify(left(code,1),"hH","m")~=0 then do
  306.                     oldname = hyphenation
  307.                     hyphenation = "\"||left(code,1)
  308.                     if hyphenation~=oldname  then change = 1
  309.                     position = position+2
  310.                     end
  311.                 when code = "lr"|code = "lf"|code = "ll" then do
  312.                     position1 = pos(">",text,position)
  313.                     position = position+4
  314.                     oldname = linespace
  315.                     linespace = substr(text,position,position1-position)
  316.                     if linespace~=oldname  then change = 1
  317.                     oldname = linespacecode
  318.                     linespacecode = code
  319.                     if linespacecode~=oldname  then change = 1
  320.                     position = position1+1
  321.                     end
  322.                 when code = "ls" then do
  323.                     position1 = pos(">",text,position)
  324.                     position = position+4
  325.                     oldname = lineshift
  326.                     lineshift = substr(text,position,position1-position)
  327.                     if lineshift~=oldname  then change = 1
  328.                     position = position1+1
  329.                     end
  330.                 when left(code,1) = "t" then do
  331.                     position1 = pos(">",text,position)
  332.                     position = position+3
  333.                     oldname = tracking
  334.                     tracking = substr(text,position,position1-position)
  335.                     if tracking~=oldname  then change = 1
  336.                     position = position1+1
  337.                     end
  338.                 when left(code,1) = "c" then do
  339.                     position1 = pos(">",text,position)
  340.                     position = position+3
  341.                     oldname = colour
  342.                     colour = substr(text,position,position1-position)
  343.                     if colour~=oldname  then change = 1
  344.                     position = position1+1
  345.                     end
  346.                 when code = "jl"|code = "jr"|code = "jc"|code = "jf" then do
  347.                     oldname = justification
  348.                     justification = "\"||code
  349.                     if justification~=oldname  then change = 1
  350.                     position = position+3
  351.                     end
  352.                 otherwise position = position+2  /* in case of non-style codes such as page numbers */
  353.                 end      /* of select */
  354.         end   /* of do forever */
  355. position = position+1
  356. return position
  357.  
  358.  
  359. /*  +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++  */
  360.  
  361. /* Parse a style tag definition  */
  362. parsetag:
  363.  
  364. parse arg tagdata
  365. tlength = length(tagdata)
  366. tposition = pos("\",tagdata)
  367. if pos = 0 then return
  368.  
  369. /* Clear all codes - the only compulsory info is the tag's name */
  370.         paraname = ""
  371.         paracode = ""
  372.         fontname = ""
  373.         typestyle = ""
  374.         fontsize = ""
  375.         bold = ""
  376.         italic = ""
  377.         underline = ""
  378.         outline = ""
  379.         kerning = ""
  380.         hyphenation = ""
  381.         linespace = ""
  382.         linespacecode = ""
  383.         lineshift = ""
  384.         tracking = ""
  385.         colour = ""
  386.         justification = ""
  387.  
  388. do forever
  389.     if substr(tagdata,tposition,1)~="\" then break
  390.     code = substr(tagdata,tposition+1,2)
  391.     select
  392.         when code = "dp" then do
  393.             paraname = ""
  394.             paracode = code
  395.             tposition = tposition+3
  396.             end
  397.         when code = "dP" then do
  398.             tposition1 = pos(">",tagdata,tposition)
  399.             tposition = tposition+4
  400.             paraname = "<"||substr(tagdata,tposition,tposition1-tposition)||">"
  401.             paracode = code
  402.             tposition = tposition1+1
  403.             end
  404.         when verify(left(code,1),"bB","m")~=0 then do
  405.             bold = "\"||left(code,1)
  406.             tposition = tposition+2
  407.             end
  408.         when verify(left(code,1),"iI","m")~=0 then do
  409.             italic = "\"||left(code,1)
  410.             tposition = tposition+2
  411.             end
  412.         when verify(left(code,1),"uU","m")~=0 then do
  413.             underline = "\"||left(code,1)
  414.             tposition = tposition+2
  415.             end
  416.         when verify(left(code,1),"oO","m")~=0 then do
  417.             outline = "\"||left(code,1)
  418.             tposition = tposition+2
  419.             end
  420.         when left(code,1) = "n" then do
  421.             typestyle = "\n"
  422.             bold = ""
  423.             italic = ""
  424.             underline = ""
  425.             outline = ""
  426.             tposition = tposition+2
  427.             end
  428.         when code = "ff" then do
  429.             tposition1 = pos(">",tagdata,tposition)
  430.             tposition = tposition+4
  431.             fontname = substr(tagdata,tposition,tposition1-tposition)
  432.             tposition = tposition1+1
  433.             end
  434.         when code = "fs" then do
  435.             tposition1 = pos(">",tagdata,tposition)
  436.             tposition = tposition+4
  437.             fontsize = substr(tagdata,tposition,tposition1-tposition)
  438.             tposition = tposition1+1
  439.             end
  440.         when verify(left(code,1),"kK","m")~=0 then do
  441.             kerning = "\"||left(code,1)
  442.             tposition = tposition+2
  443.             end
  444.         when verify(left(code,1),"hH","m")~=0 then do
  445.             hyphenation = "\"||left(code,1)
  446.             tposition = tposition+2
  447.             end
  448.         when code = "lr"|code = "lf"|code = "ll" then do
  449.             tposition1 = pos(">",tagdata,tposition)
  450.             tposition = tposition+4
  451.             linespace = substr(tagdata,tposition,tposition1-tposition)
  452.             linespacecode = code
  453.             tposition = tposition1+1
  454.             end
  455.         when code = "ls" then do
  456.             tposition1 = pos(">",tagdata,tposition)
  457.             tposition = tposition+4
  458.             lineshift = substr(tagdata,tposition,tposition1-tposition)
  459.             tposition = tposition1+1
  460.             end
  461.         when left(code,1) = "t" then do
  462.             tposition1 = pos(">",tagdata,tposition)
  463.             tposition = tposition+3
  464.             tracking = substr(tagdata,tposition,tposition1-tposition)
  465.             tposition = tposition1+1
  466.             end
  467.         when left(code,1) = "c" then do
  468.             tposition1 = pos(">",tagdata,tposition)
  469.             tposition = tposition+3
  470.             colour = substr(tagdata,tposition,tposition1-tposition)
  471.             tposition = tposition1+1
  472.             end
  473.         when code = "jl"|code = "jr"|code = "jc"|code = "jf" then do
  474.             justification = "\"||code
  475.             tposition = tposition+3
  476.             end
  477.         otherwise tposition = tposition+2
  478.         end
  479. end
  480. return
  481.  
  482. /*  ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++  */
  483.  
  484. exit_msg:
  485. do
  486.     parse arg message
  487.     if message ~="" then call ppm_inform(1,message,"Resume")
  488.     call ppm_ClearStatus()
  489.     call ppm_SetColorMode(colormode)
  490.     call ppm_AutoUpdate(1)
  491.     exit
  492. end
  493.  
  494.